(FILECREATED " 9-FEB-83 15:37:32" {PHYLUM}<GABRIEL>DESTRUCTIVE.;4 1618   

      changes to:  (FNS DESTRUCTIVE)
		   (VARS DESTRUCTIVECOMS)
		   (MACROS COLLECTN)

      previous date: " 9-FEB-83 14:03:21" {PHYLUM}<GABRIEL>DESTRUCTIVE.;3)


(* Copyright (c) 1983 by HornBlower)

(PRETTYCOMPRINT DESTRUCTIVECOMS)

(RPAQQ DESTRUCTIVECOMS ((FNS DESTRUCTIVE)
			(MACROS COLLECTN)))
(DEFINEQ

(DESTRUCTIVE
  (LAMBDA (n m)                                              (* JonL " 9-FEB-83 15:37")
    (PROG ((l (COLLECTN 10)))
          (for i from n by -1 to 1
	     do (if (NULL (CAR l))
		    then (for L on l
			    do (OR (CAR L)
				   (RPLACA L (LIST NIL)))
			       (NCONC (CAR L)
				      (COLLECTN m)))
		  else (for l1 on l as l2 on (CDR l)
			  do (RPLACD (for j from (IQUOTIENT (FLENGTH (CAR l2))
							    2)
					by -1 to 1 as a on (CAR l2) do (RPLACA a i)
					finally (RETURN a))
				     (PROG ((n (IQUOTIENT (FLENGTH (CAR l1))
							  2)))
				           (RETURN (if (ZEROP n)
						       then (RPLACA l1 NIL)
							    (CAR l1)
						     else (for j from n by -1 to 2 as a
							     on (CAR l1) do (RPLACA a i)
							     finally (RETURN (PROG1 (CDR a)
										    (RPLACD a NIL)))))
						   ))))))
          (RETURN l))))
)
(DECLARE: EVAL@COMPILE 

(PUTPROPS COLLECTN MACRO ((N)
  (PROG (VAL)
        (FRPTQ N (PUSH VAL NIL))
        (RETURN VAL))))
)
(PUTPROPS DESTRUCTIVE COPYRIGHT ("HornBlower" 1983))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (386 1405 (DESTRUCTIVE 396 . 1403)))))
STOP